home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / u / utility / packer / glotz / glotz.m < prev    next >
Encoding:
Text File  |  1996-11-17  |  10.6 KB  |  431 lines
  1. MODULE Glotz;
  2. (* v1.20 (c) 10.1992 Copyright, %-Angabe, 0C-Terminierung in LZH-Namen
  3.  * v1.15 (c)    1.1992 Martin Bauer; SFX/LZH-Routine zuverlässiger gemacht
  4.  * v1.10 (c)    5.1990 Christian Sprenger .AR, .LIB
  5.  * v1.00 (c)    2.1990 Christian Sprenger
  6.  *
  7.  * listet Inhalt von .AR, .ARC, .LIB, .LZH, .SFX und .ZOO
  8.  * - fürs Desktop zum Anmelden
  9.  *
  10.  * geschrieben in Hänisch Modula-2 [Version 5.10]
  11.  *)
  12.  
  13. IMPORT appl,inf,mouse,select,vwk;
  14. IMPORT HMExt,Str;
  15. FROM Cmd IMPORT ArgNum,ArgRead;
  16. FROM GEMDOS IMPORT Fopen,Fseek,Fread,Fclose,Fdatime,tDostime,Cconout,
  17.                 ReadOnly,WriteOnly,Update, SAbsolute,SRelative,SFromEnd;
  18. FROM Paths IMPORT GetFile,GetExt;
  19. FROM TimeDate IMPORT tTime,tDate,CardToTime,CardToDate;
  20. FROM SYSTEM IMPORT ADDRESS,ADR,TSIZE;
  21.  
  22. CONST
  23.     VER = '1.20';
  24.  
  25.  
  26. TYPE
  27.     Short = RECORD CASE:BOOLEAN OF
  28.     |  TRUE: hi,lo: CHAR
  29.     | FALSE:        sc: SHORTCARD
  30.     END END;
  31.  
  32.     Long = RECORD CASE:SHORTINT OF
  33.     |0: c0,c1,c2,c3: CHAR
  34.     |1:                  lc: LONGCARD
  35.     |2:                  li: LONGINT
  36.     END END;
  37.  
  38.     tFile = RECORD
  39.         name: ARRAY[0..13] OF CHAR;
  40.         size: LONGINT;
  41.         date,time: SHORTCARD;
  42.         len: LONGINT;
  43.     END;
  44.  
  45. CONST
  46.     LISTMAX = 999;
  47.  
  48. VAR
  49.     list: ARRAY[0..LISTMAX+3] OF tFile;
  50.  
  51. (*--------------------------------- ARC -----------------------------------*)
  52.  
  53. TYPE
  54.     tArcHdr = RECORD
  55.         rsvd1: CHAR;
  56.         flag : CHAR;                                 (*falls 0, ungültig*)
  57.         fname: ARRAY[0..11] OF CHAR;
  58.         rsvd2: CHAR;
  59.         size0,size1,size2,size3: CHAR;
  60.         date0,date1: CHAR;
  61.         time0,time1: CHAR;
  62.         crc0,crc1: CHAR;
  63.         len0,len1,len2,len3: CHAR;
  64.     END;
  65.  
  66. PROCEDURE ScanARC(VAR fname: STRING): SHORTCARD;
  67. VAR
  68.     f: SHORTINT;
  69.     h: tArcHdr;
  70.     i: SHORTINT;
  71.     j: SHORTINT;
  72.     pos: Long;
  73.     flen: LONGINT;
  74. BEGIN
  75.     f := Fopen(fname,ReadOnly);
  76.     IF f<0 THEN RETURN 0 END;
  77.     flen := Fseek(0,f,SFromEnd);
  78.     pos.li := Fseek(0,f,SAbsolute);
  79.     j := -1;
  80.     REPEAT
  81.         INC(j);
  82.         IF Fread(f,TSIZE(tArcHdr),ADR(h))#TSIZE(tArcHdr) THEN RETURN 0 END;
  83.         WITH list[j] DO
  84.             WITH h DO
  85.                 FOR i:=0 TO 11 DO name[i] := fname[i] END; name[12] := 0C;
  86.                 Short(date).lo := date0;
  87.                 Short(date).hi := date1;
  88.                 Short(time).lo := time0;
  89.                 Short(time).hi := time1;
  90.                 Long(size).c3 := size0;
  91.                 Long(size).c2 := size1;
  92.                 Long(size).c1 := size2;
  93.                 Long(size).c0 := size3;
  94.                 Long(len).c3 := len0;
  95.                 Long(len).c2 := len1;
  96.                 Long(len).c1 := len2;
  97.                 Long(len).c0 := len3;
  98.                 pos.c3 := size0;
  99.                 pos.c2 := size1;
  100.                 pos.c1 := size2;
  101.                 pos.c0 := size3;
  102.             END
  103.         END
  104.     UNTIL (h.flag=0C) (*ungültiger Eintrag*)
  105.          OR (Fseek(pos.li-1,f,SRelative) >= flen-TSIZE(tArcHdr))
  106.          OR (j=LISTMAX-1);
  107.     FileDT(f,j);
  108.     VOID(Fclose(f));
  109.     IF h.flag#0C THEN (*gültiger Eintrag*) INC(j) END;
  110.     RETURN j
  111. END ScanARC;
  112.  
  113. (*------------------------------ AR / LIB ---------------------------------*)
  114.  
  115. TYPE
  116.     tArHdr = RECORD
  117.         FName      : ARRAY[0..43] OF CHAR;
  118.         Time,Date: SHORTCARD;
  119.         Len          : ARRAY[0..11] OF CHAR;
  120.     END;
  121.  
  122. PROCEDURE ScanAR(VAR fname: STRING): SHORTCARD;
  123. VAR
  124.     f: SHORTINT;
  125.     h: tArHdr;
  126.     i: SHORTINT;
  127.     j: SHORTINT;
  128.     magic: LONGCARD;
  129.     flen,d: LONGINT;
  130. BEGIN
  131.     f := Fopen(fname,ReadOnly);
  132.     IF f<0 THEN RETURN 0 END;
  133.     flen := Fseek(0,f,SFromEnd);
  134.     d := Fseek(0,f,SAbsolute);
  135.     IF (4#Fread(f,4,ADR(magic))) OR (magic#213C6172H)
  136.     OR (4#Fread(f,4,ADR(magic))) OR (magic#63683E0AH) THEN RETURN 0 END;
  137.     j := -1;
  138.     REPEAT
  139.         INC(j);
  140.         IF Fread(f,TSIZE(tArHdr),ADR(h))#TSIZE(tArHdr) THEN RETURN 0 END;
  141.         WITH list[j] DO
  142.             WITH h DO
  143.                 FOR i:=0 TO 11 DO name[i] := FName[i] END; name[12] := 0C;
  144.                 date := Date;
  145.                 time := Time;
  146.                 len := 0; i := 0;
  147.                 WHILE ('0'<=Len[i]) & (Len[i]<='9') DO
  148.                     len := 10*len + INT(ORD(Len[i]) - 60B); INC(i)
  149.                 END;
  150.                 size := len;
  151.                 d := len; IF ODD(d) THEN INC(d) END
  152.             END
  153.         END
  154.     UNTIL (Fseek(d,f,SRelative) >= flen-TSIZE(tArHdr))
  155.          OR (j=LISTMAX-1);
  156.     FileDT(f,j);
  157.     VOID(Fclose(f));
  158.     RETURN j + 1
  159. END ScanAR;
  160.  
  161. (*------------------------------- LHZ & SFX ---------------------------------*)
  162.  
  163. CONST
  164.     cSizeOfHeaderMax=  255+2;  (* headsiz ist maximal 255 +2 für ChkSum *)
  165. TYPE
  166.     tLHArcHdr = RECORD
  167.         headsiz: CHAR;    (* headsiz+2 ist die Position des ersten Datenbytes *)
  168.         headchk: CHAR;    (* Checksum des Headers *)
  169.         mth1, mth2,mth3,mth4,mth5: CHAR;    (*Methode: "-lh0-", "-lh1-",... *)
  170.         packsiz0,packsiz1,packsiz2,packsiz3: CHAR;    (*Jetzige Gröβe*)
  171.         orgsiz0,orgsiz1,orgsiz2,orgsiz3: CHAR;            (*Original-Gröβe*)
  172.         time0,time1: CHAR;
  173.         date0,date1: CHAR;
  174.         bits0,bits1: CHAR;
  175.         fnlen: CHAR;                                        (*Länge des Filenamens*)
  176.         fname: ARRAY[0..255] OF CHAR;     (*Großzügig dimensioniert*)
  177.         (* Nach dem Filenamen kommt noch die CRC-Checksum der reinen Daten. *)
  178.         (* Im erweiterten Headerformat folgen anschließend ein paar Bytes, *)
  179.         (* deren Verwendungszweck noch nicht geklärt ist. *)
  180.     END;
  181.  
  182. PROCEDURE ScanLZH(SFX: BOOLEAN; (*selfextracting *.SFX?*)
  183.                         VAR fname: STRING): SHORTCARD;
  184. VAR
  185.     f: SHORTINT;
  186.     h: tLHArcHdr;
  187.     path: ARRAY[0..255] OF CHAR;
  188.     i: SHORTINT;
  189.     j: SHORTINT;
  190.     pos: Long;
  191.     fpos: LONGINT;
  192.     blockBytesRead: LONGINT;    (* Block entspricht einem File im Archiv *)
  193.     restOfBlock: LONGINT;
  194.  
  195.     PROCEDURE HeaderOK( VAR h:tLHArcHdr ):BOOLEAN;
  196.     TYPE
  197.         tByte     =[0..255];
  198.         tpByte    =POINTER TO tByte;
  199.     VAR
  200.         (*$R+*)p: tpByte;
  201.         (*$R+*)q: tpByte;
  202.         (*$R+*)hcs: tByte;
  203.     BEGIN
  204.         hcs := tByte(h.headchk);
  205.         p := ADR(h.mth1);
  206.         q := ADR(h.mth1) + tByte(h.headsiz);
  207.         WHILE ADDRESS(p) < ADDRESS(q) DO
  208.             hcs := hcs-p^;
  209.             INC(p)
  210.         END;
  211.         RETURN hcs=0;
  212.     END HeaderOK;
  213.  
  214. BEGIN
  215.     f := Fopen(fname,ReadOnly);
  216.     IF f<0 THEN RETURN 0 END;
  217.     IF SFX THEN
  218.         pos.li := Fseek(30,f,SAbsolute);
  219.         IF Fread(f,4,ADR(pos))#4 THEN VOID(Fclose(f)); RETURN 0 END;
  220.         IF pos.li#53465800H THEN RETURN 0 END; (*Kennung "SFX"*)
  221.         IF Fread(f,4,ADR(pos))#4 THEN VOID(Fclose(f)); RETURN 0 END;
  222.         pos.li := Fseek(pos.li,f,SAbsolute);
  223.     ELSE pos.li := Fseek(0,f,SAbsolute) END;
  224.     j := -1;
  225.     LOOP
  226.         INC(j);
  227.         blockBytesRead := Fread(f,cSizeOfHeaderMax,ADR(h));
  228.         IF (blockBytesRead < (VAL(LONGINT,ORD(h.headsiz))+2))
  229.                 OR ~HeaderOK( h ) THEN
  230.             EXIT
  231.         END;
  232.         WITH list[j] DO
  233.             WITH h DO
  234.                 Long(size).c3 := packsiz0;
  235.                 Long(size).c2 := packsiz1;
  236.                 Long(size).c1 := packsiz2;
  237.                 Long(size).c0 := packsiz3;
  238.                 Long(len).c3 := orgsiz0;
  239.                 Long(len).c2 := orgsiz1;
  240.                 Long(len).c1 := orgsiz2;
  241.                 Long(len).c0 := orgsiz3;
  242.                 Short(date).lo := date0;
  243.                 Short(date).hi := date1;
  244.                 Short(time).lo := time0;
  245.                 Short(time).hi := time1;
  246.  
  247.                 Str.CopyN(fname,path,VAL(SHORTINT,fnlen));
  248.                 path[VAL(SHORTINT,fnlen)+1] := 0C;
  249.                 GetFile(path,name);
  250.                 restOfBlock := (VAL(LONGINT,ORD(h.headsiz))+2)+size - blockBytesRead;
  251.                 fpos:=Fseek(0,f,SRelative);
  252.                 IF (Fseek(restOfBlock,f,SRelative) # fpos+restOfBlock)
  253.                         OR (j=LISTMAX-1) THEN
  254.                     EXIT
  255.                 END;
  256.             END;
  257.         END;
  258.     END;
  259.     FileDT(f,j);
  260.     VOID(Fclose(f));
  261.     RETURN j
  262. END ScanLZH;
  263.  
  264. (*--------------------------------- ZOO -----------------------------------*)
  265.  
  266. TYPE
  267.     tZooCtrl = RECORD
  268.         memo: LONGCARD; (*DCA7C4FDH*)
  269.         rsvd: Short;
  270.         next: Long;         (*Zeiger auf nächsten tZooCtrl*)
  271.         data: Long;         (*Zeiger auf komprimierte Datei*)
  272.     END;
  273.     tZooHdr = RECORD
  274.         date0,date1: CHAR;
  275.         time0,time1: CHAR;
  276.         crc1,crc2: CHAR;
  277.         len0,len1,len2,len3: CHAR;         (*Original-Gröβe*)
  278.         size0,size1,size2,size3: CHAR; (*Jetzige Gröβe*)
  279.         nix3: ARRAY[0..9] OF CHAR;
  280.         fname: ARRAY[0..12] OF CHAR;
  281.     END;
  282.  
  283. PROCEDURE ScanZOO(VAR fname: STRING): SHORTINT;
  284. VAR
  285.     f: SHORTINT;
  286.     h: tZooHdr;
  287.     c: tZooCtrl;
  288.     i: SHORTINT;
  289.     j: SHORTINT;
  290.     pos: Long;
  291. (*    flen: LONGINT;*)
  292.     ch: CHAR;
  293. BEGIN
  294.     f := Fopen(fname,ReadOnly);
  295.     IF f<0 THEN RETURN 0 END;
  296.     IF (Fread(f,4,ADR(pos))#4) OR (pos.li#5A4F4F20H) THEN RETURN 0 END; (*"ZOO"*)
  297. (*    flen := Fseek(0,f,SFromEnd);*)
  298.     IF (Fseek(24,f,SAbsolute)#24) OR (Fread(f,4,ADR(pos))#4) THEN RETURN 0 END;
  299.     ch := pos.c0; pos.c0 := pos.c3; pos.c3 := ch;
  300.     ch := pos.c1; pos.c1 := pos.c2; pos.c2 := ch;
  301.     IF pos.li#Fseek(pos.li,f,SAbsolute) THEN RETURN 0 END;
  302.     j := -1;
  303.     REPEAT
  304.         INC(j);
  305.         IF Fread(f,TSIZE(tZooCtrl),ADR(c))#TSIZE(tZooCtrl) THEN RETURN 0 END;
  306.         pos.c3 := c.next.c0;
  307.         pos.c2 := c.next.c1;
  308.         pos.c1 := c.next.c2;
  309.         pos.c0 := c.next.c3;
  310.         IF Fread(f,TSIZE(tZooHdr),ADR(h))#TSIZE(tZooHdr) THEN RETURN 0 END;
  311.         WITH list[j] DO
  312.             WITH h DO
  313.                 Long(size).c3 := size0;
  314.                 Long(size).c2 := size1;
  315.                 Long(size).c1 := size2;
  316.                 Long(size).c0 := size3;
  317.                 Long(len).c3 := len0;
  318.                 Long(len).c2 := len1;
  319.                 Long(len).c1 := len2;
  320.                 Long(len).c0 := len3;
  321.                 Short(date).lo := date0;
  322.                 Short(date).hi := date1;
  323.                 Short(time).lo := time0;
  324.                 Short(time).hi := time1;
  325.                 GetFile(fname,name);
  326.             END
  327.         END;
  328.     UNTIL (list[j].name[0]<=' ') (*ungültiger Eintrag*)
  329.          OR (Fseek(pos.li,f,SAbsolute)#pos.li) OR (j=LISTMAX-1);
  330.     FileDT(f,j);
  331.     VOID(Fclose(f));
  332.     IF list[j].name[0]>' ' THEN INC(j) END; (*gültiger Eintrag*)
  333.     RETURN j
  334. END ScanZOO;
  335.  
  336. (*-------------------------------------------------------------------------*)
  337.  
  338. PROCEDURE FileDT(fd,n: SHORTINT);
  339. VAR
  340.     dt: tDostime;
  341. BEGIN
  342.     Fdatime(dt,fd,FALSE);
  343.     WITH list[n+1] DO
  344.         date := dt.date;
  345.         time := dt.time;
  346.     END;
  347. END FileDT;
  348.  
  349. (*$E+*)
  350. PROCEDURE Line(i: SHORTINT; VAR res: STRING; usr: ADDRESS);
  351. VAR
  352.     j,k: SHORTINT;
  353.     s: ARRAY[0..61] OF CHAR;
  354.     str: ARRAY[0..9] OF CHAR;
  355.     d: tDate;
  356.     t: tTime;
  357. BEGIN
  358.     (*s := 'xxxxxxxx.xxx  ssssssss  llllllll  tt.mm.jj  hh.mm.ss';*)
  359.     IF (i>n) OR (i=n-1) THEN s := ''
  360.     ELSIF i=n-3 THEN
  361.         s := '------------  --------  --------                    ';
  362.     ELSIF i=n THEN
  363.         s := 'v'+VER+'  ©1989-92 Christian Sprenger, Modular Systems GbR    ';
  364.     ELSE
  365.         WITH list[i] DO
  366.             j := 0;
  367.             WHILE (name[j]#'.') & (name[j]#0C) DO
  368.                 s[j] := name[j]; INC(j)
  369.             END;
  370.             FOR k:=j TO 8 DO s[k] := ' ' END; k := 9;
  371.             IF name[j]#0C THEN INC(j);
  372.                 WHILE name[j]#0C DO
  373.                     s[k] := name[j]; INC(j); INC(k)
  374.                 END
  375.             END;
  376.             FOR j:=k TO 13 DO s[j] := ' ' END;
  377.             s[14] := 0C;
  378.             s := FORM(s,len:8,'  ',size:8,'  ');
  379.             CardToDate(date,d);
  380.             CardToTime(time,t);
  381.             s := FORM(s,
  382.                 d.day:2, '.',d.month:2:10:'0','.',d.year MOD 100:2:10:'0','  ',
  383.                 t.hour:2,':',t.min:2:10:'0',    ':',t.sec:2:10:'0',' ',
  384.                 100 - size*100 DIV len:3,'%');
  385.         END;
  386.     END;
  387.     Str.Assign(res,s);
  388. END Line;
  389. (*$E-*)
  390.  
  391. VAR
  392.     fname: ARRAY[0..79] OF CHAR;
  393.     ext: ARRAY[0..3] OF CHAR;
  394.     i,n: SHORTINT;
  395.     s: ARRAY[0..79] OF CHAR;
  396. BEGIN
  397.     IF (appl.init()>=0) & vwk.init() THEN
  398.         inf.init;
  399.         IF ArgNum()>1 THEN
  400.             n := 0;
  401.             ArgRead(1,fname); GetExt(fname,ext);
  402.             IF        Str.Compare(ext,'ARC')=0 THEN n := ScanARC(fname)
  403.             ELSIF (Str.Compare(ext,'AR')=0)
  404.                  OR (Str.Compare(ext,HMExt.Lib)=0)    THEN n := ScanAR(fname)
  405.             ELSIF (Str.Compare(ext,'LZH')=0)
  406.                  OR (Str.Compare(ext,'SFX')=0) THEN n := ScanLZH(ext[0]='S',fname)
  407.             ELSIF Str.Compare(ext,'ZOO')=0 THEN n := ScanZOO(fname)
  408.             END;
  409.             IF n>0 THEN
  410.                 INC(n,3);
  411.                 WITH list[n-2] DO
  412.                     (* date, time sind gesetzt *)
  413.                     name := FORM('Gesamt: .',n-3:3);
  414.                     size := 0;
  415.                     len := 0;
  416.                     FOR i:=0 TO n-3 DO
  417.                         INC(size,list[i].size);
  418.                         INC(len,list[i].len);
  419.                     END
  420.                 END;
  421.                 mouse.arrow;
  422.                 i := select.do(TRUE,fname,n+1,57,Line,NIL,-1)
  423.             ELSE
  424.                 Cconout(7C)
  425.             END
  426.         END
  427.     END;
  428.     vwk.exit;
  429.     appl.exit;
  430. END Glotz.
  431.